home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / gui / eagui30.lha / EAGUI / Modula2 / txt / EAGuiMacros.mod < prev    next >
Encoding:
Modula Implementation  |  1994-12-01  |  10.5 KB  |  319 lines
  1. (* REVISION HEADER ×××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××× *
  2.    
  3.  | $VER: EAGuiMacros.imp 3.00 (23.11.94) by Stefan Schulz [sts]
  4.  
  5.  | Desc: Interface to EAGUI.library
  6.  
  7.  | Dist: This Module is © Copyright 1994 by Stefan Schulz
  8.  
  9.  | Rqrs: Amiga OS 2.0 or higher
  10.  |       EAGUI.library V3
  11.  |       EAGUI - Environment Adaptive Graphic User Interface
  12.  |       Copyright © 1993, 1994 by Marcel Offermans and Frank Groen
  13.  
  14.  | Lang: M2Amiga
  15.  | Trns: M2Amiga Modula 2 Software Development System
  16.  |       © Copyright by A+L AG, CH-2540 Grenchen
  17.  
  18.  | Hist: Version \date\
  19.  |
  20.  |       3.00   \23.11.94\
  21.  |              interface adapted to EAGUI.library V3
  22.  |              names changed to M2-Standard
  23.  |
  24.  |       1.00   \01.05.94\
  25.  |              initial Version
  26.  
  27.  * ×××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××× *)
  28.  
  29. IMPLEMENTATION MODULE EAGuiMacros;
  30.  
  31. (*$ DEFINE Locale:= FALSE
  32.  
  33.     StackParms:= FALSE
  34.     NilChk    := FALSE
  35.     EntryClear:= FALSE
  36.     LargeVars := FALSE
  37. *)
  38.  
  39. (* IMPORTS ********************************************************************** *)
  40.  
  41. IMPORT  d       : EAGuiD,
  42.         l       : EAGuiL;
  43.  
  44. IMPORT  ed      : ExecD,
  45.         gt      : GadToolsD,
  46.         gd      : GraphicsD,
  47.         S       : SYSTEM,
  48.         ud      : UtilityD;
  49.  
  50. (* ****************************************************************************** *)
  51.  
  52. VAR     buffer  : ARRAY [1..50] OF LONGINT;     (* for taglists *)
  53.  
  54.  
  55. PROCEDURE HGroup          (     tags        : ud.TagItemPtr     ) : d.OPTR;
  56.  BEGIN
  57.  RETURN l.NewObjectA
  58.                 (d.typeHGroup,
  59.                  S.TAG(buffer,
  60.                        d.standardMethod, d.smMinSize+d.smBorder,
  61.                        ud.tagMore, tags,
  62.                  ud.tagEnd));
  63.  END HGroup;
  64.  
  65.  
  66. PROCEDURE VGroup          (     tags        : ud.TagItemPtr     ) : d.OPTR;
  67.  BEGIN
  68.  RETURN l.NewObjectA
  69.                 (d.typeVGroup,
  70.                  S.TAG(buffer,
  71.                        d.standardMethod, d.smMinSize+d.smBorder,
  72.                        ud.tagMore, tags,
  73.                  ud.tagEnd));
  74.  END VGroup;
  75.  
  76.  
  77. (*$ IF  Locale  *)
  78. PROCEDURE GTString        (     text        : d.StrPtr;
  79.                                 tags        : ud.TagItemPtr     ) : d.OPTR;
  80. (*$ ELSE        *)(*$ CopyDyn:= FALSE *)
  81. PROCEDURE GTString        (     text        : ARRAY OF CHAR;
  82.                                 tags        : ud.TagItemPtr     ) : d.OPTR;
  83. (*$ ENDIF       *)
  84.  BEGIN
  85.  RETURN l.NewObjectA
  86.                 (d.typeGTGadget,
  87.                  S.TAG(buffer,
  88.                        d.standardMethod, d.smMinSize+d.smBorder,
  89.                        d.gtType,   gt.stringKind,
  90.                        (*$ IF  Locale  *)
  91.                          d.gtText, text,
  92.                        (*$ ELSE        *)
  93.                          d.gtText, S.ADR(text),
  94.                        (*$ ENDIF       *)
  95.                        d.gtFlags,  gt.placetextLeft,
  96.                        ud.tagMore, tags,
  97.                  ud.tagEnd));
  98.  END GTString;
  99.  
  100.  
  101. (*$ IF  Locale  *)
  102. PROCEDURE GTText          (     text        : d.StrPtr;
  103.                                 tags        : ud.TagItemPtr     ) : d.OPTR;
  104. (*$ ELSE        *)(*$ CopyDyn:= FALSE *)
  105. PROCEDURE GTText          (     text        : ARRAY OF CHAR;
  106.                                 tags        : ud.TagItemPtr     ) : d.OPTR;
  107. (*$ ENDIF       *)
  108.  BEGIN
  109.  RETURN l.NewObjectA
  110.                 (d.typeGTGadget,
  111.                  S.TAG(buffer,
  112.                        d.standardMethod, d.smMinSize+d.smBorder,
  113.                        d.gtType,   gt.textKind,
  114.                        (*$ IF  Locale  *)
  115.                          d.gtText, text,
  116.                        (*$ ELSE        *)
  117.                          d.gtText, S.ADR(text),
  118.                        (*$ ENDIF       *)
  119.                        d.gtFlags,  gt.placetextLeft,
  120.                        ud.tagMore, tags,
  121.                  ud.tagEnd));
  122.  END GTText;
  123.  
  124.  
  125. (*$ IF  Locale  *)
  126. PROCEDURE GTButton        (     text        : d.StrPtr;
  127.                                 tags        : ud.TagItemPtr     ) : d.OPTR;
  128. (*$ ELSE        *)(*$ CopyDyn:= FALSE *)
  129. PROCEDURE GTButton        (     text        : ARRAY OF CHAR;
  130.                                 tags        : ud.TagItemPtr     ) : d.OPTR;
  131. (*$ ENDIF       *)
  132.  BEGIN
  133.  RETURN l.NewObjectA
  134.                 (d.typeGTGadget,
  135.                  S.TAG(buffer,
  136.                        d.standardMethod, d.smMinSize+d.smBorder,
  137.                        d.gtType,   gt.buttonKind,
  138.                        (*$ IF  Locale  *)
  139.                          d.gtText, text,
  140.                        (*$ ELSE        *)
  141.                          d.gtText, S.ADR(text),
  142.                        (*$ ENDIF       *)
  143.                        d.gtFlags,  gt.placetextLeft,
  144.                        ud.tagMore, tags,
  145.                  ud.tagEnd));
  146.  END GTButton;
  147.  
  148.  
  149. PROCEDURE GTScroller      (     tags        : ud.TagItemPtr     ) : d.OPTR;
  150.  BEGIN
  151.  RETURN l.NewObjectA
  152.                 (d.typeGTGadget,
  153.                  S.TAG(buffer,
  154.                        d.standardMethod, d.smMinSize+d.smBorder,
  155.                        d.gtType,   gt.scrollerKind,
  156.                        ud.tagMore, tags,
  157.                  ud.tagEnd));
  158.  END GTScroller;
  159.  
  160.  
  161. PROCEDURE GTSlider        (     tags        : ud.TagItemPtr     ) : d.OPTR;
  162.  BEGIN
  163.  RETURN l.NewObjectA
  164.                 (d.typeGTGadget,
  165.                  S.TAG(buffer,
  166.                        d.standardMethod, d.smMinSize+d.smBorder,
  167.                        d.gtType,   gt.sliderKind,
  168.                        ud.tagMore, tags,
  169.                  ud.tagEnd));
  170.  END GTSlider;
  171.  
  172.  
  173. (*$ IF  Locale  *)
  174. PROCEDURE GTCheckBox      (     text        : d.StrPtr;
  175.                                 tags        : ud.TagItemPtr     ) : d.OPTR;
  176. (*$ ELSE        *)(*$ CopyDyn:= FALSE *)
  177. PROCEDURE GTCheckBox      (     text        : ARRAY OF CHAR;
  178.                                 tags        : ud.TagItemPtr     ) : d.OPTR;
  179. (*$ ENDIF       *)
  180.  BEGIN
  181.  RETURN l.NewObjectA
  182.                 (d.typeGTGadget,
  183.                  S.TAG(buffer,
  184.                        d.standardMethod, d.smMinSize+d.smBorder,
  185.                        d.gtType,   gt.checkboxKind,
  186.                        (*$ IF  Locale  *)
  187.                          d.gtText, text,
  188.                        (*$ ELSE        *)
  189.                          d.gtText, S.ADR(text),
  190.                        (*$ ENDIF       *)
  191.                        d.gtFlags,  gt.placetextLeft,
  192.                        ud.tagMore, tags,
  193.                  ud.tagEnd));
  194.  END GTCheckBox;
  195.  
  196.  
  197. (*$ IF  Locale  *)
  198. PROCEDURE GTInteger       (     text        : d.StrPtr;
  199.                                 tags        : ud.TagItemPtr     ) : d.OPTR;
  200. (*$ ELSE        *)(*$ CopyDyn:= FALSE *)
  201. PROCEDURE GTInteger       (     text        : ARRAY OF CHAR;
  202.                                 tags        : ud.TagItemPtr     ) : d.OPTR;
  203. (*$ ENDIF       *)
  204.  BEGIN
  205.  RETURN l.NewObjectA
  206.                 (d.typeGTGadget,
  207.                  S.TAG(buffer,
  208.                        d.standardMethod, d.smMinSize+d.smBorder,
  209.                        d.gtType,   gt.integerKind,
  210.                        (*$ IF  Locale  *)
  211.                          d.gtText, text,
  212.                        (*$ ELSE        *)
  213.                          d.gtText, S.ADR(text),
  214.                        (*$ ENDIF       *)
  215.                        d.gtFlags,  gt.placetextLeft,
  216.                        ud.tagMore, tags,
  217.                  ud.tagEnd));
  218.  END GTInteger;
  219.  
  220.  
  221. (*$ IF  Locale  *)
  222. PROCEDURE GTNumber        (     text        : d.StrPtr;
  223.                                 tags        : ud.TagItemPtr     ) : d.OPTR;
  224. (*$ ELSE        *)(*$ CopyDyn:= FALSE *)
  225. PROCEDURE GTNumber        (     text        : ARRAY OF CHAR;
  226.                                 tags        : ud.TagItemPtr     ) : d.OPTR;
  227. (*$ ENDIF       *)
  228.  BEGIN
  229.  RETURN l.NewObjectA
  230.                 (d.typeGTGadget,
  231.                  S.TAG(buffer,
  232.                        d.standardMethod, d.smMinSize+d.smBorder,
  233.                        d.gtType,   gt.numberKind,
  234.                        (*$ IF  Locale  *)
  235.                          d.gtText, text,
  236.                        (*$ ELSE        *)
  237.                          d.gtText, S.ADR(text),
  238.                        (*$ ENDIF       *)
  239.                        d.gtFlags,  gt.placetextLeft,
  240.                        ud.tagMore, tags,
  241.                  ud.tagEnd));
  242.  END GTNumber;
  243.  
  244.  
  245. (*$ IF  Locale  *)
  246. PROCEDURE GTListView      (     text        : d.StrPtr;
  247.                                 tags        : ud.TagItemPtr     ) : d.OPTR;
  248. (*$ ELSE        *)(*$ CopyDyn:= FALSE *)
  249. PROCEDURE GTListView      (     text        : ARRAY OF CHAR;
  250.                                 tags        : ud.TagItemPtr     ) : d.OPTR;
  251. (*$ ENDIF       *)
  252.  BEGIN
  253.  RETURN l.NewObjectA
  254.                 (d.typeGTGadget,
  255.                  S.TAG(buffer,
  256.                        d.standardMethod, d.smMinSize+d.smBorder,
  257.                        d.gtType,   gt.listviewKind,
  258.                        (*$ IF  Locale  *)
  259.                          d.gtText, text,
  260.                        (*$ ELSE        *)
  261.                          d.gtText, S.ADR(text),
  262.                        (*$ ENDIF       *)
  263.                        d.gtFlags,  gt.placetextAbove,
  264.                        ud.tagMore, tags,
  265.                  ud.tagEnd));
  266.  END GTListView;
  267.  
  268.  
  269. PROCEDURE GTMX            (     tags        : ud.TagItemPtr     ) : d.OPTR;
  270.  BEGIN
  271.  RETURN l.NewObjectA
  272.                 (d.typeGTGadget,
  273.                  S.TAG(buffer,
  274.                        d.standardMethod, d.smMinSize+d.smBorder,
  275.                        d.gtType,   gt.mxKind,
  276.                        ud.tagMore, tags,
  277.                  ud.tagEnd));
  278.  END GTMX;
  279.  
  280.  
  281. PROCEDURE GTCycle         (     tags        : ud.TagItemPtr     ) : d.OPTR;
  282.  BEGIN
  283.  RETURN l.NewObjectA
  284.                 (d.typeGTGadget,
  285.                  S.TAG(buffer,
  286.                        d.standardMethod, d.smMinSize+d.smBorder,
  287.                        d.gtType,   gt.cycleKind,
  288.                        ud.tagMore, tags,
  289.                  ud.tagEnd));
  290.  END GTCycle;
  291.  
  292.  
  293. PROCEDURE GTPalette       (     tags        : ud.TagItemPtr     ) : d.OPTR;
  294.  BEGIN
  295.  RETURN l.NewObjectA
  296.                 (d.typeGTGadget,
  297.                  S.TAG(buffer,
  298.                        d.standardMethod, d.smMinSize+d.smBorder,
  299.                        d.gtType,   gt.paletteKind,
  300.                        ud.tagMore, tags,
  301.                  ud.tagEnd));
  302.  END GTPalette;
  303.  
  304.  
  305. PROCEDURE EmptyBox        (     weight      : LONGINT;
  306.                                 tags        : ud.TagItemPtr     ) : d.OPTR;
  307.  BEGIN
  308.  RETURN l.NewObjectA
  309.                 (d.typeGTGadget,
  310.                  S.TAG(buffer,
  311.                        d.standardMethod, d.smMinSize+d.smBorder,
  312.                        d.weight,   weight,
  313.                        ud.tagMore, tags,
  314.                  ud.tagEnd));
  315.  END EmptyBox;
  316.  
  317.  
  318. END EAGuiMacros.imp
  319.